home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / Tickle-4.0 (tcl) / tcl / src / tclUnixUtil.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-11-10  |  36.5 KB  |  1,390 lines  |  [TEXT/MPS ]
  1. #ifdef MPW
  2. #    pragma segment TCL_2
  3. #endif
  4.  
  5. /* 
  6.  * tclUnixUtil.c --
  7.  *
  8.  *    This file contains a collection of utility procedures that
  9.  *    are present in the Tcl's UNIX core but not in the generic
  10.  *    core.  For example, they do file manipulation and process
  11.  *    manipulation.
  12.  *
  13.  *    Parts of this file are based on code contributed by Karl
  14.  *    Lehenbauer, Mark Diekhans and Peter da Silva.
  15.  *
  16.  * Copyright (c) 1991-1993 The Regents of the University of California.
  17.  * All rights reserved.
  18.  *
  19.  * Permission is hereby granted, without written agreement and without
  20.  * license or royalty fees, to use, copy, modify, and distribute this
  21.  * software and its documentation for any purpose, provided that the
  22.  * above copyright notice and the following two paragraphs appear in
  23.  * all copies of this software.
  24.  * 
  25.  * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
  26.  * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
  27.  * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
  28.  * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  29.  *
  30.  * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
  31.  * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
  32.  * AND FITNESS FOR A PARTICULAR PURPOSE.  THE SOFTWARE PROVIDED HEREUNDER IS
  33.  * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
  34.  * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
  35.  */
  36.  
  37. #ifndef lint
  38. static char rcsid[] = "$Header: /user6/ouster/tcl/RCS/tclUnixUtil.c,v 1.44 93/09/09 14:40:28 ouster Exp $ SPRITE (Berkeley)";
  39. #endif /* not lint */
  40.  
  41. #include "tclInt.h"
  42. #include "tclUnix.h"
  43.  
  44. /*
  45.  * A linked list of the following structures is used to keep track
  46.  * of child processes that have been detached but haven't exited
  47.  * yet, so we can make sure that they're properly "reaped" (officially
  48.  * waited for) and don't lie around as zombies cluttering the
  49.  * system.
  50.  */
  51.  
  52. typedef struct Detached {
  53.     int pid;                /* Id of process that's been detached
  54.                      * but isn't known to have exited. */
  55.     struct Detached *nextPtr;        /* Next in list of all detached
  56.                      * processes. */
  57. } Detached;
  58.  
  59. static Detached *detList = NULL;    /* List of all detached proceses. */
  60.  
  61. /*
  62.  * The following variables are used to keep track of all the open files
  63.  * in the process.  These files can be shared across interpreters, so the
  64.  * information can't be put in the Interp structure.
  65.  */
  66.  
  67. int tclNumFiles = 0;        /* Number of entries in tclOpenFiles below.
  68.                  * 0 means array hasn't been created yet. */
  69. OpenFile **tclOpenFiles;    /* Pointer to malloc-ed array of pointers
  70.                  * to information about open files.  Entry
  71.                  * N corresponds to the file with fileno N.
  72.                  * If an entry is NULL then the corresponding
  73.                  * file isn't open.  If tclOpenFiles is NULL
  74.                  * it means no files have been used, so even
  75.                  * stdin/stdout/stderr entries haven't been
  76.                  * setup yet. */
  77.  
  78. /*
  79.  * Declarations for local procedures defined in this file:
  80.  */
  81.  
  82. static int        FileForRedirect _ANSI_ARGS_((Tcl_Interp *interp,
  83.                 char *spec, int atOk, char *arg, int flags,
  84.                 char *nextArg, int *skipPtr, int *closePtr));
  85. static void        MakeFileTable _ANSI_ARGS_((Interp *iPtr, int index));
  86. static void        RestoreSignals _ANSI_ARGS_((void));
  87.  
  88. /*
  89.  *----------------------------------------------------------------------
  90.  *
  91.  * Tcl_EvalFile --
  92.  *
  93.  *    Read in a file and process the entire file as one gigantic
  94.  *    Tcl command.
  95.  *
  96.  * Results:
  97.  *    A standard Tcl result, which is either the result of executing
  98.  *    the file or an error indicating why the file couldn't be read.
  99.  *
  100.  * Side effects:
  101.  *    Depends on the commands in the file.
  102.  *
  103.  *----------------------------------------------------------------------
  104.  */
  105.  
  106. int
  107. Tcl_EvalFile(interp, fileName)
  108.     Tcl_Interp *interp;        /* Interpreter in which to process file. */
  109.     char *fileName;        /* Name of file to process.  Tilde-substitution
  110.                  * will be performed on this name. */
  111. {
  112.     int fileId, result;
  113.     struct stat statBuf;
  114.     char *cmdBuffer, *oldScriptFile;
  115.     Interp *iPtr = (Interp *) interp;
  116.     Tcl_DString buffer;
  117.  
  118.     oldScriptFile = iPtr->scriptFile;
  119.     iPtr->scriptFile = fileName;
  120.     fileName = Tcl_TildeSubst(interp, fileName, &buffer);
  121.     if (fileName == NULL) {
  122.     goto error;
  123.     }
  124.     fileId = open(fileName, O_RDONLY, 0);
  125.     if (fileId < 0) {
  126.     Tcl_AppendResult(interp, "couldn't read file \"", fileName,
  127.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  128.     goto error;
  129.     }
  130.     if (fstat(fileId, &statBuf) == -1) {
  131.     Tcl_AppendResult(interp, "couldn't stat file \"", fileName,
  132.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  133.     close(fileId);
  134.     goto error;
  135.     }
  136.     cmdBuffer = (char *) ckalloc((unsigned) statBuf.st_size+1);
  137.     if (read(fileId, cmdBuffer, (size_t) statBuf.st_size) != statBuf.st_size) {
  138.     Tcl_AppendResult(interp, "error in reading file \"", fileName,
  139.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  140.     close(fileId);
  141.     ckfree(cmdBuffer);
  142.     goto error;
  143.     }
  144.     if (close(fileId) != 0) {
  145.     Tcl_AppendResult(interp, "error closing file \"", fileName,
  146.         "\": ", Tcl_PosixError(interp), (char *) NULL);
  147.     ckfree(cmdBuffer);
  148.     goto error;
  149.     }
  150.     cmdBuffer[statBuf.st_size] = 0;
  151.     result = Tcl_Eval(interp, cmdBuffer);
  152.     if (result == TCL_RETURN) {
  153.     result = TCL_OK;
  154.     }
  155.     if (result == TCL_ERROR) {
  156.     char msg[200];
  157.  
  158.     /*
  159.      * Record information telling where the error occurred.
  160.      */
  161.  
  162.     sprintf(msg, "\n    (file \"%.150s\" line %d)", fileName,
  163.         interp->errorLine);
  164.     Tcl_AddErrorInfo(interp, msg);
  165.     }
  166.     ckfree(cmdBuffer);
  167.     iPtr->scriptFile = oldScriptFile;
  168.     Tcl_DStringFree(&buffer);
  169.     return result;
  170.  
  171. error:
  172.     iPtr->scriptFile = oldScriptFile;
  173.     Tcl_DStringFree(&buffer);
  174.     return TCL_ERROR;
  175. }
  176.  
  177. /*
  178.  *----------------------------------------------------------------------
  179.  *
  180.  * Tcl_DetachPids --
  181.  *
  182.  *    This procedure is called to indicate that one or more child
  183.  *    processes have been placed in background and will never be
  184.  *    waited for;  they should eventually be reaped by
  185.  *    Tcl_ReapDetachedProcs.
  186.  *
  187.  * Results:
  188.  *    None.
  189.  *
  190.  * Side effects:
  191.  *    None.
  192.  *
  193.  *----------------------------------------------------------------------
  194.  */
  195.  
  196. void
  197. Tcl_DetachPids(numPids, pidPtr)
  198.     int numPids;        /* Number of pids to detach:  gives size
  199.                  * of array pointed to by pidPtr. */
  200.     int *pidPtr;        /* Array of pids to detach. */
  201. {
  202. #ifndef macintosh
  203.  
  204.     register Detached *detPtr;
  205.     int i;
  206.  
  207.     for (i = 0; i < numPids; i++) {
  208.     detPtr = (Detached *) ckalloc(sizeof(Detached));
  209.     detPtr->pid = pidPtr[i];
  210.     detPtr->nextPtr = detList;
  211.     detList = detPtr;
  212.     }
  213. #endif
  214. }
  215.  
  216. /*
  217.  *----------------------------------------------------------------------
  218.  *
  219.  * Tcl_ReapDetachedProcs --
  220.  *
  221.  *    This procedure checks to see if any detached processes have
  222.  *    exited and, if so, it "reaps" them by officially waiting on
  223.  *    them.  It should be called "occasionally" to make sure that
  224.  *    all detached processes are eventually reaped.
  225.  *
  226.  * Results:
  227.  *    None.
  228.  *
  229.  * Side effects:
  230.  *    Processes are waited on, so that they can be reaped by the
  231.  *    system.
  232.  *
  233.  *----------------------------------------------------------------------
  234.  */
  235.  
  236. void
  237. Tcl_ReapDetachedProcs()
  238. {
  239. #ifndef macintosh
  240.  
  241.     register Detached *detPtr;
  242.     Detached *nextPtr, *prevPtr;
  243.     int status, result;
  244.  
  245.     for (detPtr = detList, prevPtr = NULL; detPtr != NULL; ) {
  246.     result = waitpid(detPtr->pid, &status, WNOHANG);
  247.     if ((result == 0) || ((result == -1) && (errno != ECHILD))) {
  248.         prevPtr = detPtr;
  249.         detPtr = detPtr->nextPtr;
  250.         continue;
  251.     }
  252.     nextPtr = detPtr->nextPtr;
  253.     if (prevPtr == NULL) {
  254.         detList = detPtr->nextPtr;
  255.     } else {
  256.         prevPtr->nextPtr = detPtr->nextPtr;
  257.     }
  258.     ckfree((char *) detPtr);
  259.     detPtr = nextPtr;
  260.     }
  261. #endif
  262. }
  263.  
  264. /*
  265.  *----------------------------------------------------------------------
  266.  *
  267.  * Tcl_CreatePipeline --
  268.  *
  269.  *    Given an argc/argv array, instantiate a pipeline of processes
  270.  *    as described by the argv.
  271.  *
  272.  * Results:
  273.  *    The return value is a count of the number of new processes
  274.  *    created, or -1 if an error occurred while creating the pipeline.
  275.  *    *pidArrayPtr is filled in with the address of a dynamically
  276.  *    allocated array giving the ids of all of the processes.  It
  277.  *    is up to the caller to free this array when it isn't needed
  278.  *    anymore.  If inPipePtr is non-NULL, *inPipePtr is filled in
  279.  *    with the file id for the input pipe for the pipeline (if any):
  280.  *    the caller must eventually close this file.  If outPipePtr
  281.  *    isn't NULL, then *outPipePtr is filled in with the file id
  282.  *    for the output pipe from the pipeline:  the caller must close
  283.  *    this file.  If errFilePtr isn't NULL, then *errFilePtr is filled
  284.  *    with a file id that may be used to read error output after the
  285.  *    pipeline completes.
  286.  *
  287.  * Side effects:
  288.  *    Processes and pipes are created.
  289.  *
  290.  *----------------------------------------------------------------------
  291.  */
  292.  
  293. int
  294. Tcl_CreatePipeline(interp, argc, argv, pidArrayPtr, inPipePtr,
  295.     outPipePtr, errFilePtr)
  296.     Tcl_Interp *interp;        /* Interpreter to use for error reporting. */
  297.     int argc;            /* Number of entries in argv. */
  298.     char **argv;        /* Array of strings describing commands in
  299.                  * pipeline plus I/O redirection with <,
  300.                  * <<,  >, etc.  Argv[argc] must be NULL. */
  301.     int **pidArrayPtr;        /* Word at *pidArrayPtr gets filled in with
  302.                  * address of array of pids for processes
  303.                  * in pipeline (first pid is first process
  304.                  * in pipeline). */
  305.     int *inPipePtr;        /* If non-NULL, input to the pipeline comes
  306.                  * from a pipe (unless overridden by
  307.                  * redirection in the command).  The file
  308.                  * id with which to write to this pipe is
  309.                  * stored at *inPipePtr.  -1 means command
  310.                  * specified its own input source. */
  311.     int *outPipePtr;        /* If non-NULL, output to the pipeline goes
  312.                  * to a pipe, unless overriden by redirection
  313.                  * in the command.  The file id with which to
  314.                  * read frome this pipe is stored at
  315.                  * *outPipePtr.  -1 means command specified
  316.                  * its own output sink. */
  317.     int *errFilePtr;        /* If non-NULL, all stderr output from the
  318.                  * pipeline will go to a temporary file
  319.                  * created here, and a descriptor to read
  320.                  * the file will be left at *errFilePtr.
  321.                  * The file will be removed already, so
  322.                  * closing this descriptor will be the end
  323.                  * of the file.  If this is NULL, then
  324.                  * all stderr output goes to our stderr.
  325.                  * If the pipeline specifies redirection
  326.                  * then the fill will still be created
  327.                  * but it will never get any data. */
  328. {
  329. #ifdef macintosh
  330.  
  331.     return -1;
  332.  
  333. #else
  334.  
  335.     int *pidPtr = NULL;        /* Points to malloc-ed array holding all
  336.                  * the pids of child processes. */
  337.     int numPids = 0;        /* Actual number of processes that exist
  338.                  * at *pidPtr right now. */
  339.     int cmdCount;        /* Count of number of distinct commands
  340.                  * found in argc/argv. */
  341.     char *input = NULL;        /* If non-null, then this points to a
  342.                  * string containing input data (specified
  343.                  * via <<) to be piped to the first process
  344.                  * in the pipeline. */
  345.     int inputId = -1;        /* If >= 0, gives file id to use as input for
  346.                  * first process in pipeline (specified via
  347.                  * < or <@). */
  348.     int closeInput = 0;        /* If non-zero, then must close inputId
  349.                  * when cleaning up (zero means the file needs
  350.                  * to stay open for some other reason). */
  351.     int outputId = -1;        /* Writable file id for output from last
  352.                  * command in pipeline (could be file or pipe).
  353.                  * -1 means use stdout. */
  354.     int closeOutput = 0;    /* Non-zero means must close outputId when
  355.                  * cleaning up (similar to closeInput). */
  356.     int errorId = -1;        /* Writable file id for error output from
  357.                  * all commands in pipeline. -1 means use
  358.                  * stderr. */
  359.     int closeError = 0;        /* Non-zero means must close errorId when
  360.                  * cleaning up. */
  361.     int pipeIds[2];        /* File ids for pipe that's being created. */
  362.     int firstArg, lastArg;    /* Indexes of first and last arguments in
  363.                  * current command. */
  364.     int skip;            /* Number of arguments to skip (because they
  365.                  * specify redirection). */
  366.     int lastBar;
  367.     char *execName;
  368.     int i, j, pid;
  369.     char *p;
  370.     Tcl_DString buffer;
  371.  
  372.     if (inPipePtr != NULL) {
  373.     *inPipePtr = -1;
  374.     }
  375.     if (outPipePtr != NULL) {
  376.     *outPipePtr = -1;
  377.     }
  378.     if (errFilePtr != NULL) {
  379.     *errFilePtr = -1;
  380.     }
  381.     pipeIds[0] = pipeIds[1] = -1;
  382.  
  383.     /*
  384.      * First, scan through all the arguments to figure out the structure
  385.      * of the pipeline.  Process all of the input and output redirection
  386.      * arguments and remove them from the argument list in the pipeline.
  387.      * Count the number of distinct processes (it's the number of "|"
  388.      * arguments plus one) but don't remove the "|" arguments.
  389.      */
  390.  
  391.     cmdCount = 1;
  392.     lastBar = -1;
  393.     for (i = 0; i < argc; i++) {
  394.     if ((argv[i][0] == '|') && (((argv[i][1] == 0))
  395.         || ((argv[i][1] == '&') && (argv[i][2] == 0)))) {
  396.         if ((i == (lastBar+1)) || (i == (argc-1))) {
  397.         interp->result = "illegal use of | or |& in command";
  398.         return -1;
  399.         }
  400.         lastBar = i;
  401.         cmdCount++;
  402.         continue;
  403.     } else if (argv[i][0] == '<') {
  404.         if ((inputId >= 0) && closeInput) {
  405.         close(inputId);
  406.         }
  407.         inputId = -1;
  408.         skip = 1;
  409.         if (argv[i][1] == '<') {
  410.         input = argv[i]+2;
  411.         if (*input == 0) {
  412.             input = argv[i+1];
  413.             if (input == 0) {
  414.             Tcl_AppendResult(interp, "can't specify \"", argv[i],
  415.                 "\" as last word in command", (char *) NULL);
  416.             goto error;
  417.             }
  418.             skip = 2;
  419.         }
  420.         } else {
  421.         input = 0;
  422.         inputId = FileForRedirect(interp, argv[i]+1, 1, argv[i],
  423.             O_RDONLY, argv[i+1], &skip, &closeInput);
  424.         if (inputId < 0) {
  425.             goto error;
  426.         }
  427.         }
  428.     } else if (argv[i][0] == '>') {
  429.         int append, useForStdErr, useForStdOut, mustClose, fd, atOk, flags;
  430.  
  431.         skip = atOk = 1;
  432.         append = useForStdErr = 0;
  433.         useForStdOut = 1;
  434.         if (argv[i][1] == '>') {
  435.         p = argv[i] + 2;
  436.         append = 1;
  437.         atOk = 0;
  438.         flags = O_WRONLY|O_CREAT;
  439.         } else {
  440.         p = argv[i] + 1;
  441.         flags = O_WRONLY|O_CREAT|O_TRUNC;
  442.         }
  443.         if (*p == '&') {
  444.         useForStdErr = 1;
  445.         p++;
  446.         }
  447.         fd = FileForRedirect(interp, p, atOk, argv[i], flags, argv[i+1],
  448.             &skip, &mustClose);
  449.         if (fd < 0) {
  450.         goto error;
  451.         }
  452.         if (append) {
  453.         lseek(fd, 0L, 2);
  454.         }
  455.  
  456.         /*
  457.          * Got the file descriptor.  Now use it for standard output,
  458.          * standard error, or both, depending on the redirection.
  459.          */
  460.  
  461.         if (useForStdOut) {
  462.         if ((outputId > 0) && closeOutput) {
  463.             close(outputId);
  464.         }
  465.         outputId = fd;
  466.         closeOutput = mustClose;
  467.         }
  468.         if (useForStdErr) {
  469.         if ((errorId > 0) && closeError) {
  470.             close(errorId);
  471.         }
  472.         errorId = fd;
  473.         closeError = (useForStdOut) ? 0 : mustClose;
  474.         }
  475.     } else if ((argv[i][0] == '2') && (argv[i][1] == '>')) {
  476.         int append, atOk, flags;
  477.  
  478.         if ((errorId > 0) && closeError) {
  479.         close(errorId);
  480.         }
  481.         skip = 1;
  482.         p = argv[i] + 2;
  483.         if (*p == '>') {
  484.         p++;
  485.         append = 1;
  486.         atOk = 0;
  487.         flags = O_WRONLY|O_CREAT;
  488.         } else {
  489.         append = 0;
  490.         atOk = 1;
  491.         flags = O_WRONLY|O_CREAT|O_TRUNC;
  492.         }
  493.         errorId = FileForRedirect(interp, p, atOk, argv[i], flags,
  494.             argv[i+1], &skip, &closeError);
  495.         if (errorId < 0) {
  496.         goto error;
  497.         }
  498.         if (append) {
  499.         lseek(errorId, 0L, 2);
  500.         }
  501.     } else {
  502.         continue;
  503.     }
  504.     for (j = i+skip; j < argc; j++) {
  505.         argv[j-skip] = argv[j];
  506.     }
  507.     argc -= skip;
  508.     i -= 1;            /* Process next arg from same position. */
  509.     }
  510.     if (argc == 0) {
  511.     interp->result =  "didn't specify command to execute";
  512.     return -1;
  513.     }
  514.  
  515.     if (inputId < 0) {
  516.     if (input != NULL) {
  517.         char inName[L_tmpnam];
  518.         int length;
  519.  
  520.         /*
  521.          * The input for the first process is immediate data coming from
  522.          * Tcl.  Create a temporary file for it and put the data into the
  523.          * file.
  524.          */
  525.  
  526.         tmpnam(inName);
  527.         inputId = open(inName, O_RDWR|O_CREAT|O_TRUNC, 0600);
  528.         closeInput = 1;
  529.         if (inputId < 0) {
  530.         Tcl_AppendResult(interp,
  531.             "couldn't create input file for command: ",
  532.             Tcl_PosixError(interp), (char *) NULL);
  533.         goto error;
  534.         }
  535.         length = strlen(input);
  536.         if (write(inputId, input, (size_t) length) != length) {
  537.         Tcl_AppendResult(interp,
  538.             "couldn't write file input for command: ",
  539.             Tcl_PosixError(interp), (char *) NULL);
  540.         goto error;
  541.         }
  542.         if ((lseek(inputId, 0L, 0) == -1) || (unlink(inName) == -1)) {
  543.         Tcl_AppendResult(interp,
  544.             "couldn't reset or remove input file for command: ",
  545.             Tcl_PosixError(interp), (char *) NULL);
  546.         goto error;
  547.         }
  548.     } else if (inPipePtr != NULL) {
  549.         /*
  550.          * The input for the first process in the pipeline is to
  551.          * come from a pipe that can be written from this end.
  552.          */
  553.  
  554.         if (pipe(pipeIds) != 0) {
  555.         Tcl_AppendResult(interp,
  556.             "couldn't create input pipe for command: ",
  557.             Tcl_PosixError(interp), (char *) NULL);
  558.         goto error;
  559.         }
  560.         inputId = pipeIds[0];
  561.         closeInput = 1;
  562.         *inPipePtr = pipeIds[1];
  563.         pipeIds[0] = pipeIds[1] = -1;
  564.     }
  565.     }
  566.  
  567.     /*
  568.      * Set up a pipe to receive output from the pipeline, if no other
  569.      * output sink has been specified.
  570.      */
  571.  
  572.     if ((outputId < 0) && (outPipePtr != NULL)) {
  573.     if (pipe(pipeIds) != 0) {
  574.         Tcl_AppendResult(interp,
  575.             "couldn't create output pipe: ",
  576.             Tcl_PosixError(interp), (char *) NULL);
  577.         goto error;
  578.     }
  579.     outputId = pipeIds[1];
  580.     closeOutput = 1;
  581.     *outPipePtr = pipeIds[0];
  582.     pipeIds[0] = pipeIds[1] = -1;
  583.     }
  584.  
  585.     /*
  586.      * Set up the standard error output sink for the pipeline, if
  587.      * requested.  Use a temporary file which is opened, then deleted.
  588.      * Could potentially just use pipe, but if it filled up it could
  589.      * cause the pipeline to deadlock:  we'd be waiting for processes
  590.      * to complete before reading stderr, and processes couldn't complete
  591.      * because stderr was backed up.
  592.      */
  593.  
  594.     if (errFilePtr != NULL) {
  595.     char errName[L_tmpnam];
  596.  
  597.     tmpnam(errName);
  598.     *errFilePtr = open(errName, O_RDONLY|O_CREAT|O_TRUNC, 0600);
  599.     if (*errFilePtr < 0) {
  600.         errFileError:
  601.         Tcl_AppendResult(interp,
  602.             "couldn't create error file for command: ",
  603.             Tcl_PosixError(interp), (char *) NULL);
  604.         goto error;
  605.     }
  606.     if (errorId < 0) {
  607.         errorId = open(errName, O_WRONLY|O_CREAT|O_TRUNC, 0600);
  608.         if (errorId < 0) {
  609.         goto errFileError;
  610.         }
  611.         closeError = 1;
  612.     }
  613.     if (unlink(errName) == -1) {
  614.         Tcl_AppendResult(interp,
  615.             "couldn't remove error file for command: ",
  616.             Tcl_PosixError(interp), (char *) NULL);
  617.         goto error;
  618.     }
  619.     }
  620.  
  621.     /*
  622.      * Scan through the argc array, forking off a process for each
  623.      * group of arguments between "|" arguments.
  624.      */
  625.  
  626.     pidPtr = (int *) ckalloc((unsigned) (cmdCount * sizeof(int)));
  627.     for (i = 0; i < numPids; i++) {
  628.     pidPtr[i] = -1;
  629.     }
  630.     Tcl_ReapDetachedProcs();
  631.     for (firstArg = 0; firstArg < argc; numPids++, firstArg = lastArg+1) {
  632.     int joinThisError;
  633.     int curOutputId;
  634.  
  635.     joinThisError = 0;
  636.     for (lastArg = firstArg; lastArg < argc; lastArg++) {
  637.         if (argv[lastArg][0] == '|') {
  638.         if (argv[lastArg][1] == 0) {
  639.             break;
  640.         }
  641.         if ((argv[lastArg][1] == '&') && (argv[lastArg][2] == 0)) {
  642.             joinThisError = 1;
  643.             break;
  644.         }
  645.         }
  646.     }
  647.     argv[lastArg] = NULL;
  648.     if (lastArg == argc) {
  649.         curOutputId = outputId;
  650.     } else {
  651.         if (pipe(pipeIds) != 0) {
  652.         Tcl_AppendResult(interp, "couldn't create pipe: ",
  653.             Tcl_PosixError(interp), (char *) NULL);
  654.         goto error;
  655.         }
  656.         curOutputId = pipeIds[1];
  657.     }
  658.     execName = Tcl_TildeSubst(interp, argv[firstArg], &buffer);
  659.     pid = fork();
  660.     if (pid == 0) {
  661.         char errSpace[200];
  662.  
  663.         if (((inputId != -1) && (dup2(inputId, 0) == -1))
  664.             || ((curOutputId != -1) && (dup2(curOutputId, 1) == -1))
  665.             || (joinThisError && (dup2(1, 2) == -1))
  666.             || (!joinThisError && (errorId != -1)
  667.                 && (dup2(errorId, 2) == -1))) {
  668.         char *err;
  669.         err = "forked process couldn't set up input/output\n";
  670.         write(errorId < 0 ? 2 : errorId, err, (size_t) strlen(err));
  671.         _exit(1);
  672.         }
  673.         for (i = 3; (i <= curOutputId) || (i <= inputId)
  674.             || (i <= outputId) || (i <= errorId); i++) {
  675.         close(i);
  676.         }
  677.         RestoreSignals();
  678.         execvp(execName, &argv[firstArg]);
  679.         sprintf(errSpace, "couldn't find \"%.150s\" to execute\n",
  680.             argv[firstArg]);
  681.         write(2, errSpace, (size_t) strlen(errSpace));
  682.         _exit(1);
  683.     }
  684.     Tcl_DStringFree(&buffer);
  685.     if (pid == -1) {
  686.         Tcl_AppendResult(interp, "couldn't fork child process: ",
  687.             Tcl_PosixError(interp), (char *) NULL);
  688.         goto error;
  689.     }
  690.     pidPtr[numPids] = pid;
  691.  
  692.     /*
  693.      * Close off our copies of file descriptors that were set up for
  694.      * this child, then set up the input for the next child.
  695.      */
  696.  
  697.     if ((inputId != -1) && closeInput) {
  698.         close(inputId);
  699.     }
  700.     if ((curOutputId != -1) && (curOutputId != outputId)) {
  701.         close(curOutputId);
  702.     }
  703.     inputId = pipeIds[0];
  704.     closeInput = 1;
  705.     pipeIds[0] = pipeIds[1] = -1;
  706.     }
  707.     *pidArrayPtr = pidPtr;
  708.  
  709.     /*
  710.      * All done.  Cleanup open files lying around and then return.
  711.      */
  712.  
  713. cleanup:
  714.     if ((inputId != -1) && closeInput) {
  715.     close(inputId);
  716.     }
  717.     if ((outputId != -1) && closeOutput) {
  718.     close(outputId);
  719.     }
  720.     if ((errorId != -1) && closeError) {
  721.     close(errorId);
  722.     }
  723.     return numPids;
  724.  
  725.     /*
  726.      * An error occurred.  There could have been extra files open, such
  727.      * as pipes between children.  Clean them all up.  Detach any child
  728.      * processes that have been created.
  729.      */
  730.  
  731.     error:
  732.     if ((inPipePtr != NULL) && (*inPipePtr != -1)) {
  733.     close(*inPipePtr);
  734.     *inPipePtr = -1;
  735.     }
  736.     if ((outPipePtr != NULL) && (*outPipePtr != -1)) {
  737.     close(*outPipePtr);
  738.     *outPipePtr = -1;
  739.     }
  740.     if ((errFilePtr != NULL) && (*errFilePtr != -1)) {
  741.     close(*errFilePtr);
  742.     *errFilePtr = -1;
  743.     }
  744.     if (pipeIds[0] != -1) {
  745.     close(pipeIds[0]);
  746.     }
  747.     if (pipeIds[1] != -1) {
  748.     close(pipeIds[1]);
  749.     }
  750.     if (pidPtr != NULL) {
  751.     for (i = 0; i < numPids; i++) {
  752.         if (pidPtr[i] != -1) {
  753.         Tcl_DetachPids(1, &pidPtr[i]);
  754.         }
  755.     }
  756.     ckfree((char *) pidPtr);
  757.     }
  758.     numPids = -1;
  759.     goto cleanup;
  760. #endif
  761. }
  762.  
  763. /*
  764.  *----------------------------------------------------------------------
  765.  *
  766.  * FileForRedirect --
  767.  *
  768.  *    This procedure does much of the work of parsing redirection
  769.  *    operators.  It handles "@" if specified and allowed, and a file
  770.  *    name, and opens the file if necessary.
  771.  *
  772.  * Results:
  773.  *    The return value is the descriptor number for the file.  If an
  774.  *    error occurs then -1 is returned and an error message is left
  775.  *    in interp->result.  Several arguments are side-effected; see
  776.  *    the argument list below for details.
  777.  *
  778.  * Side effects:
  779.  *    None.
  780.  *
  781.  *----------------------------------------------------------------------
  782.  */
  783.  
  784. static int
  785. FileForRedirect(interp, spec, atOk, arg, flags, nextArg, skipPtr, closePtr)
  786.     Tcl_Interp *interp;            /* Intepreter to use for error
  787.                      * reporting. */
  788.     register char *spec;            /* Points to character just after
  789.                      * redirection character. */
  790.     int atOk;                /* Non-zero means '@' notation is
  791.                      * OK, zero means it isn't. */
  792.     char *arg;                /* Pointer to entire argument
  793.                      * containing spec:  used for error
  794.                      * reporting. */
  795.     int flags;                /* Flags to use for opening file. */
  796.     char *nextArg;            /* Next argument in argc/argv
  797.                      * array, if needed for file name.
  798.                      * May be NULL. */
  799.     int *skipPtr;            /* This value is incremented if
  800.                      * nextArg is used for redirection
  801.                      * spec. */
  802.     int *closePtr;            /* This value is set to 1 if the file
  803.                      * that's returned must be closed, 0
  804.                      * if it was specified with "@" so
  805.                      * it must be left open. */
  806. {
  807.     int writing = (flags & O_WRONLY);
  808.     FILE *f;
  809.     int fd;
  810.  
  811.     if (atOk && (*spec == '@')) {
  812.     spec++;
  813.     if (*spec == 0) {
  814.         spec = nextArg;
  815.         if (spec == NULL) {
  816.         goto badLastArg;
  817.         }
  818.         *skipPtr += 1;
  819.     }
  820.     if (Tcl_GetOpenFile(interp, spec, writing, 1, &f) != TCL_OK) {
  821.         return -1;
  822.     }
  823.     *closePtr = 0;
  824.     fd = fileno(f);
  825.     } else {
  826.     if (*spec == 0) {
  827.         spec = nextArg;
  828.         if (spec == NULL) {
  829.         goto badLastArg;
  830.         }
  831.         *skipPtr += 1;
  832.     }
  833.     fd = open(spec, flags, 0666);
  834.     if (fd < 0) {
  835.         Tcl_AppendResult(interp, "couldn't ",
  836.             (writing) ? "write" : "read", " file \"", spec, "\": ",
  837.             Tcl_PosixError(interp), (char *) NULL);
  838.         return -1;
  839.     }
  840.     *closePtr = 1;
  841.     }
  842.     return fd;
  843.  
  844.     badLastArg:
  845.     Tcl_AppendResult(interp, "can't specify \"", arg,
  846.         "\" as last word in command", (char *) NULL);
  847.     return -1;
  848. }
  849.  
  850. /*
  851.  *----------------------------------------------------------------------
  852.  *
  853.  * RestoreSignals --
  854.  *
  855.  *    This procedure is invoked in a forked child process just before
  856.  *    exec-ing a new program to restore all signals to their default
  857.  *    settings.
  858.  *
  859.  * Results:
  860.  *    None.
  861.  *
  862.  * Side effects:
  863.  *    Signal settings get changed.
  864.  *
  865.  *----------------------------------------------------------------------
  866.  */
  867.  
  868. static void
  869. RestoreSignals()
  870. {
  871. #ifndef macintosh
  872. #ifdef SIGABRT
  873.     signal(SIGABRT, SIG_DFL);
  874. #endif
  875. #ifdef SIGALRM
  876.     signal(SIGALRM, SIG_DFL);
  877. #endif
  878. #ifdef SIGFPE
  879.     signal(SIGFPE, SIG_DFL);
  880. #endif
  881. #ifdef SIGHUP
  882.     signal(SIGHUP, SIG_DFL);
  883. #endif
  884. #ifdef SIGILL
  885.     signal(SIGILL, SIG_DFL);
  886. #endif
  887. #ifdef SIGINT
  888.     signal(SIGINT, SIG_DFL);
  889. #endif
  890. #ifdef SIGPIPE
  891.     signal(SIGPIPE, SIG_DFL);
  892. #endif
  893. #ifdef SIGQUIT
  894.     signal(SIGQUIT, SIG_DFL);
  895. #endif
  896. #ifdef SIGSEGV
  897.     signal(SIGSEGV, SIG_DFL);
  898. #endif
  899. #ifdef SIGTERM
  900.     signal(SIGTERM, SIG_DFL);
  901. #endif
  902. #ifdef SIGUSR1
  903.     signal(SIGUSR1, SIG_DFL);
  904. #endif
  905. #ifdef SIGUSR2
  906.     signal(SIGUSR2, SIG_DFL);
  907. #endif
  908. #ifdef SIGCHLD
  909.     signal(SIGCHLD, SIG_DFL);
  910. #endif
  911. #ifdef SIGCONT
  912.     signal(SIGCONT, SIG_DFL);
  913. #endif
  914. #ifdef SIGTSTP
  915.     signal(SIGTSTP, SIG_DFL);
  916. #endif
  917. #ifdef SIGTTIN
  918.     signal(SIGTTIN, SIG_DFL);
  919. #endif
  920. #ifdef SIGTTOU
  921.     signal(SIGTTOU, SIG_DFL);
  922. #endif
  923. #endif
  924. }
  925.  
  926. /*
  927.  *----------------------------------------------------------------------
  928.  *
  929.  * Tcl_PosixError --
  930.  *
  931.  *    This procedure is typically called after UNIX kernel calls
  932.  *    return errors.  It stores machine-readable information about
  933.  *    the error in $errorCode returns an information string for
  934.  *    the caller's use.
  935.  *
  936.  * Results:
  937.  *    The return value is a human-readable string describing the
  938.  *    error, as returned by strerror.
  939.  *
  940.  * Side effects:
  941.  *    The global variable $errorCode is reset.
  942.  *
  943.  *----------------------------------------------------------------------
  944.  */
  945.  
  946. char *
  947. Tcl_PosixError(interp)
  948.     Tcl_Interp *interp;        /* Interpreter whose $errorCode variable
  949.                  * is to be changed. */
  950. {
  951.     char *id, *msg;
  952.  
  953.     id = Tcl_ErrnoId();
  954.     msg = strerror(errno);
  955.     Tcl_SetErrorCode(interp, "POSIX", id, msg, (char *) NULL);
  956.     return msg;
  957. }
  958.  
  959. /*
  960.  *----------------------------------------------------------------------
  961.  *
  962.  * MakeFileTable --
  963.  *
  964.  *    Create or enlarge the file table for the interpreter, so that
  965.  *    there is room for a given index.
  966.  *
  967.  * Results:
  968.  *    None.
  969.  *
  970.  * Side effects:
  971.  *    The file table for iPtr will be created if it doesn't exist
  972.  *    (and entries will be added for stdin, stdout, and stderr).
  973.  *    If it already exists, then it will be grown if necessary.
  974.  *
  975.  *----------------------------------------------------------------------
  976.  */
  977.  
  978.     /* ARGSUSED */
  979. static void
  980. MakeFileTable(iPtr, index)
  981.     Interp *iPtr;        /* Interpreter whose table of files is
  982.                  * to be manipulated. */
  983.     int index;            /* Make sure table is large enough to
  984.                  * hold at least this index. */
  985. {
  986.     /*
  987.      * If the table doesn't even exist, then create it and initialize
  988.      * entries for standard files.
  989.      */
  990.  
  991.     if (tclNumFiles == 0) {
  992.     OpenFile *oFilePtr;
  993.     int i;
  994.  
  995.     if (index < 2) {
  996.         tclNumFiles = 3;
  997.     } else {
  998.         tclNumFiles = index+1;
  999.     }
  1000.     tclOpenFiles = (OpenFile **) ckalloc((unsigned)
  1001.         ((tclNumFiles)*sizeof(OpenFile *)));
  1002.     for (i = tclNumFiles-1; i >= 0; i--) {
  1003.         tclOpenFiles[i] = NULL;
  1004.     }
  1005.  
  1006.     oFilePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
  1007.     oFilePtr->f = stdin;
  1008.     oFilePtr->f2 = NULL;
  1009.     oFilePtr->permissions = TCL_FILE_READABLE;
  1010.     oFilePtr->numPids = 0;
  1011.     oFilePtr->pidPtr = NULL;
  1012.     oFilePtr->errorId = -1;
  1013.     tclOpenFiles[0] = oFilePtr;
  1014.  
  1015.     oFilePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
  1016.     oFilePtr->f = stdout;
  1017.     oFilePtr->f2 = NULL;
  1018.     oFilePtr->permissions = TCL_FILE_WRITABLE;
  1019.     oFilePtr->numPids = 0;
  1020.     oFilePtr->pidPtr = NULL;
  1021.     oFilePtr->errorId = -1;
  1022.     tclOpenFiles[1] = oFilePtr;
  1023.  
  1024.     oFilePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
  1025.     oFilePtr->f = stderr;
  1026.     oFilePtr->f2 = NULL;
  1027.     oFilePtr->permissions = TCL_FILE_WRITABLE;
  1028.     oFilePtr->numPids = 0;
  1029.     oFilePtr->pidPtr = NULL;
  1030.     oFilePtr->errorId = -1;
  1031.     tclOpenFiles[2] = oFilePtr;
  1032.     } else if (index >= tclNumFiles) {
  1033.     int newSize;
  1034.     OpenFile **newPtrArray;
  1035.     int i;
  1036.  
  1037.     newSize = index+1;
  1038.     newPtrArray = (OpenFile **) ckalloc((unsigned)
  1039.         ((newSize)*sizeof(OpenFile *)));
  1040.     memcpy((VOID *) newPtrArray, (VOID *) tclOpenFiles,
  1041.         tclNumFiles*sizeof(OpenFile *));
  1042.     for (i = tclNumFiles; i < newSize; i++) {
  1043.         newPtrArray[i] = NULL;
  1044.     }
  1045.     ckfree((char *) tclOpenFiles);
  1046.     tclNumFiles = newSize;
  1047.     tclOpenFiles = newPtrArray;
  1048.     }
  1049. }
  1050.  
  1051. /*
  1052.  *----------------------------------------------------------------------
  1053.  *
  1054.  * Tcl_EnterFile --
  1055.  *
  1056.  *    This procedure is used to enter an already-open file into the
  1057.  *    file table for an interpreter so that the file can be read
  1058.  *    and written with Tcl commands.
  1059.  *
  1060.  * Results:
  1061.  *    There is no return value, but interp->result is set to
  1062.  *    hold Tcl's id for the open file, such as "file4".
  1063.  *
  1064.  * Side effects:
  1065.  *    "File" is added to the files accessible from interp.
  1066.  *
  1067.  *----------------------------------------------------------------------
  1068.  */
  1069.  
  1070. void
  1071. Tcl_EnterFile(interp, file, permissions)
  1072.     Tcl_Interp *interp;        /* Interpreter in which to make file
  1073.                  * available. */
  1074.     FILE *file;            /* File to make available in interp. */
  1075.     int permissions;        /* Ops that may be done on file:  OR-ed
  1076.                  * combinination of TCL_FILE_READABLE and
  1077.                  * TCL_FILE_WRITABLE. */
  1078. {
  1079.     Interp *iPtr = (Interp *) interp;
  1080.     int fd;
  1081.     register OpenFile *oFilePtr;
  1082.  
  1083.     fd = fileno(file);
  1084.     if (fd >= tclNumFiles) {
  1085.     MakeFileTable(iPtr, fd);
  1086.     }
  1087.     oFilePtr = tclOpenFiles[fd];
  1088.  
  1089.     /*
  1090.      * It's possible that there already appears to be a file open in
  1091.      * the slot.  This could happen, for example, if the application
  1092.      * closes a file behind our back so that we don't have a chance
  1093.      * to clean up.  This is probably a bad idea, but if it happens
  1094.      * just discard the information in the old record (hopefully the
  1095.      * application is smart enough to have really cleaned everything
  1096.      * up right).
  1097.      */
  1098.  
  1099.     if (oFilePtr == NULL) {
  1100.     oFilePtr = (OpenFile *) ckalloc(sizeof(OpenFile));
  1101.     tclOpenFiles[fd] = oFilePtr;
  1102.     }
  1103.     oFilePtr->f = file;
  1104.     oFilePtr->f2 = NULL;
  1105.     oFilePtr->permissions = permissions;
  1106.     oFilePtr->numPids = 0;
  1107.     oFilePtr->pidPtr = NULL;
  1108.     oFilePtr->errorId = -1;
  1109.     if (fd <= 2) {
  1110.     if (fd == 0) {
  1111.         interp->result = "stdin";
  1112.     } else if (fd == 1) {
  1113.         interp->result = "stdout";
  1114.     } else {
  1115.         interp->result = "stderr";
  1116.     }
  1117.     } else {
  1118.     sprintf(interp->result, "file%d", fd);
  1119.     }
  1120. }
  1121.  
  1122. /*
  1123.  *----------------------------------------------------------------------
  1124.  *
  1125.  * Tcl_GetOpenFile --
  1126.  *
  1127.  *    Given a string identifier for an open file, find the corresponding
  1128.  *    open file structure, if there is one.
  1129.  *
  1130.  * Results:
  1131.  *    A standard Tcl return value.  If the open file is successfully
  1132.  *    located and meets any usage check requested by checkUsage, TCL_OK
  1133.  *    is returned and *filePtr is modified to hold a pointer to its
  1134.  *    FILE structure.  If an error occurs then TCL_ERROR is returned
  1135.  *    and interp->result contains an error message.
  1136.  *
  1137.  * Side effects:
  1138.  *    None.
  1139.  *
  1140.  *----------------------------------------------------------------------
  1141.  */
  1142.  
  1143. int
  1144. Tcl_GetOpenFile(interp, string, forWriting, checkUsage, filePtr)
  1145.     Tcl_Interp *interp;        /* Interpreter in which to find file. */
  1146.     char *string;        /* String that identifies file. */
  1147.     int forWriting;        /* 1 means the file is going to be used
  1148.                  * for writing, 0 means for reading. */
  1149.     int checkUsage;        /* 1 means verify that the file was opened
  1150.                  * in a mode that allows the access specified
  1151.                  * by "forWriting". */
  1152.     FILE **filePtr;        /* Store pointer to FILE structure here. */
  1153. {
  1154.     OpenFile *oFilePtr;
  1155.     int fd = 0;            /* Initial value needed only to stop compiler
  1156.                  * warnings. */
  1157.     Interp *iPtr = (Interp *) interp;
  1158.  
  1159.     if ((string[0] == 'f') && (string[1] == 'i') && (string[2] == 'l')
  1160.         & (string[3] == 'e')) {
  1161.     char *end;
  1162.  
  1163.     fd = strtoul(string+4, &end, 10);
  1164.     if ((end == string+4) || (*end != 0)) {
  1165.         goto badId;
  1166.     }
  1167.     } else if ((string[0] == 's') && (string[1] == 't')
  1168.         && (string[2] == 'd')) {
  1169.     if (strcmp(string+3, "in") == 0) {
  1170.         fd = 0;
  1171.     } else if (strcmp(string+3, "out") == 0) {
  1172.         fd = 1;
  1173.     } else if (strcmp(string+3, "err") == 0) {
  1174.         fd = 2;
  1175.     } else {
  1176.         goto badId;
  1177.     }
  1178.     } else {
  1179.     badId:
  1180.     Tcl_AppendResult(interp, "bad file identifier \"", string,
  1181.         "\"", (char *) NULL);
  1182.     return TCL_ERROR;
  1183.     }
  1184.  
  1185.     if (fd >= tclNumFiles) {
  1186.     if ((tclNumFiles == 0) && (fd <= 2)) {
  1187.         MakeFileTable(iPtr, fd);
  1188.     } else {
  1189.         notOpen:
  1190.         Tcl_AppendResult(interp, "file \"", string, "\" isn't open",
  1191.             (char *) NULL);
  1192.         return TCL_ERROR;
  1193.     }
  1194.     }
  1195.     oFilePtr = tclOpenFiles[fd];
  1196.     if (oFilePtr == NULL) {
  1197.     goto notOpen;
  1198.     }
  1199.     if (forWriting) {
  1200.     if (checkUsage && !(oFilePtr->permissions & TCL_FILE_WRITABLE)) {
  1201.         Tcl_AppendResult(interp, "\"", string,
  1202.             "\" wasn't opened for writing", (char *) NULL);
  1203.         return TCL_ERROR;
  1204.     }
  1205.     if (oFilePtr->f2 != NULL) {
  1206.         *filePtr = oFilePtr->f2;
  1207.     } else {
  1208.         *filePtr = oFilePtr->f;
  1209.     }
  1210.     } else {
  1211.     if (checkUsage && !(oFilePtr->permissions & TCL_FILE_READABLE)) {
  1212.         Tcl_AppendResult(interp, "\"", string,
  1213.             "\" wasn't opened for reading", (char *) NULL);
  1214.         return TCL_ERROR;
  1215.     }
  1216.     *filePtr = oFilePtr->f;
  1217.     }
  1218.     return TCL_OK;
  1219. }
  1220.  
  1221. /*
  1222.  *----------------------------------------------------------------------
  1223.  *
  1224.  * Tcl_FilePermissions --
  1225.  *
  1226.  *    Given a FILE * pointer, return the read/write permissions
  1227.  *    associated with the open file.
  1228.  *
  1229.  * Results:
  1230.  *    If file is currently open, the return value is an OR-ed
  1231.  *    combination of TCL_FILE_READABLE and TCL_FILE_WRITABLE,
  1232.  *    which indicates the operations permitted on the open file.
  1233.  *    If the file isn't open then the return value is -1.
  1234.  *
  1235.  * Side effects:
  1236.  *    None.
  1237.  *
  1238.  *----------------------------------------------------------------------
  1239.  */
  1240.  
  1241. int
  1242. Tcl_FilePermissions(file)
  1243.     FILE *file;            /* File for which permissions are wanted. */
  1244. {
  1245.     register OpenFile *oFilePtr;
  1246.     int i, fd;
  1247.  
  1248.     /*
  1249.      * First try the entry in tclOpenFiles given by the file descriptor
  1250.      * for the file.  If that doesn't match then search all the entries
  1251.      * in tclOpenFiles.
  1252.      */
  1253.  
  1254.     if (file != NULL) {
  1255.     fd = fileno(file);
  1256.     if (fd < tclNumFiles) {
  1257.         oFilePtr = tclOpenFiles[fd];
  1258.         if ((oFilePtr != NULL) && (oFilePtr->f == file)) {
  1259.         return oFilePtr->permissions;
  1260.         }
  1261.     }
  1262.     }
  1263.     for (i = 0; i < tclNumFiles; i++) {
  1264.     oFilePtr = tclOpenFiles[i];
  1265.     if (oFilePtr == NULL) {
  1266.         continue;
  1267.     }
  1268.     if ((oFilePtr->f == file) || (oFilePtr->f2 == file)) {
  1269.         return oFilePtr->permissions;
  1270.     }
  1271.     }
  1272.     return -1;
  1273. }
  1274.  
  1275. /*
  1276.  *----------------------------------------------------------------------
  1277.  *
  1278.  * TclOpen, etc. --
  1279.  *
  1280.  *    Below are a bunch of procedures that are used by Tcl instead
  1281.  *    of system calls.  Each of the procedures executes the
  1282.  *    corresponding system call and retries automatically
  1283.  *    if the system call was interrupted by a signal.
  1284.  *
  1285.  * Results:
  1286.  *    Whatever the system call would normally return.
  1287.  *
  1288.  * Side effects:
  1289.  *    Whatever the system call would normally do.
  1290.  *
  1291.  * NOTE:
  1292.  *    This should be the last page of this file, since it undefines
  1293.  *    the macros that redirect read etc. to the procedures below.
  1294.  *
  1295.  *----------------------------------------------------------------------
  1296.  */
  1297.  
  1298. #undef open
  1299. int
  1300. TclOpen(path, oflag, mode)
  1301.     char *path;
  1302.     int oflag;
  1303.     int mode;
  1304. {
  1305.     int result;
  1306.     while (1) {
  1307. #ifdef macintosh
  1308.     result = open(path, oflag);
  1309. #else
  1310.     result = open(path, oflag, mode);
  1311. #endif
  1312.     if ((result != -1) || (errno != EINTR)) {
  1313.         return result;
  1314.     }
  1315.     }
  1316. }
  1317.  
  1318. #undef read
  1319. int
  1320. TclRead(fd, buf, numBytes)
  1321.     int fd;
  1322.     VOID *buf;
  1323.     size_t numBytes;
  1324. {
  1325.     int result;
  1326.     while (1) {
  1327.     result = read(fd, buf, (size_t) numBytes);
  1328.     if ((result != -1) || (errno != EINTR)) {
  1329.         return result;
  1330.     }
  1331.     }
  1332. }
  1333.  
  1334. #ifdef macintosh
  1335.  
  1336. typedef int        pid_t;
  1337.  
  1338. #else
  1339.  
  1340. #undef waitpid
  1341. extern pid_t waitpid _ANSI_ARGS_((pid_t pid, int *stat_loc, int options));
  1342.  
  1343. #endif
  1344.  
  1345. /*
  1346.  * Note:  the #ifdef below is needed to avoid compiler errors on systems
  1347.  * that have ANSI compilers and also define pid_t to be short.  The
  1348.  * problem is a complex one having to do with argument type promotion.
  1349.  */
  1350.  
  1351. #ifdef _USING_PROTOTYPES_
  1352. int
  1353. TclWaitpid _ANSI_ARGS_((pid_t pid, int *statPtr, int options))
  1354. #else
  1355. int
  1356. TclWaitpid(pid, statPtr, options)
  1357.     pid_t pid;
  1358.     int *statPtr;
  1359.     int options;
  1360. #endif /* _USING_PROTOTYPES_ */
  1361. {
  1362. #ifdef macintosh
  1363.     return -1;
  1364. #else
  1365.     int result;
  1366.     while (1) {
  1367.     result = waitpid(pid, statPtr, options);
  1368.     if ((result != -1) || (errno != EINTR)) {
  1369.         return result;
  1370.     }
  1371.     }
  1372. #endif
  1373. }
  1374.  
  1375. #undef write
  1376. int
  1377. TclWrite(fd, buf, numBytes)
  1378.     int fd;
  1379.     VOID *buf;
  1380.     size_t numBytes;
  1381. {
  1382.     int result;
  1383.     while (1) {
  1384.     result = write(fd, buf, (size_t) numBytes);
  1385.     if ((result != -1) || (errno != EINTR)) {
  1386.         return result;
  1387.     }
  1388.     }
  1389. }
  1390.